home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 2
/
SPACE - Library 2 - Volume 1.iso
/
demos
/
275
/
pascal
/
fastread.inc
< prev
next >
Wrap
Text File
|
1988-06-25
|
32KB
|
870 lines
{*************************************************************}
{* Eric's FASTREAD Routines *}
{* *}
{* Written by: *}
{* Eric W. Wedaa *}
{* 4620 East 17th Street *}
{* Tucson AZ, 85711 *}
{* *}
{* Copyrighted 1987 by Eric W. Wedaa *}
{* *}
{* BIX: EWEDAA *}
{* CIS: 76515,2274 *}
{* *}
{* Release Date: August 27, 1987. *}
{* *}
{* *}
{* Release Date: June 20, 1987. *}
{* Second Release Date: Feb. 21, 1988 *}
{* Third Release date: June 25, 1988. *}
{* *}
{* Don't let it be said I don't support my users. *}
{*************************************************************}
{* *}
{* Written for OSS Pascal Version 1.14 *}
{* GEM/TOS in ROM Version 1.00 *}
{* *}
{* Released in the Public Domain! *}
{* *}
{*************************************************************}
{* *}
{* Design Tools included: *}
{* Eric's Pascal Utilities, *}
{* Eric's Pascal Editor, *}
{* 1st Word ver 1.03, by GST, *}
{* Alt, By Michtron, *}
{* OSS Pascal, By O.S.S. and C.C.D. *}
{* and, Eric's Library Disk for OSS Pascal. *}
{* *}
{*************************************************************}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{++ The following files are needed to use these routines ++}
{++ --Fastread.inc ++}
{++ --Fastread.con ++}
{++ --Fastread.typ ++}
{++ --Fastread.doc ++}
{++ --Read.Me ++}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{Copyright 1987 by Eric W. Wedaa}
{Don't forget to include the FASTREAD constants and types. }
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Gemdos File Create Command. 111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION F_Create (VAR
A_File_Name : Path_Chars ; { File name in "C" format. }
Mode : INTEGER) { Mode to open the file. }
: INTEGER ; { Error Number. }
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
{ For this application, mode is always set to 0 for writing}
{ the file only. }
GEMDOS ($3C) ;
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Gemdos File Open Command. 11111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION F_Open (VAR
A_File_Name : Path_Chars ; { File name in "C" format. }
Mode : INTEGER) { Mode to open the file. }
: INTEGER ; { Error Number. }
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
{ For this application, mode is always set to 0 for reading}
{ the file only. }
GEMDOS ($3D) ;
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Gemdos File Close Command. 111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION File_Close (HANDLE : INTEGER) {File handle. }
: INTEGER ; { Error Number. }
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
GEMDOS ($3E) ;
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Gemdos File Read Command. 1111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION F_Read (HANDLE : INTEGER ; {File Handle. }
Count : LONG_INTEGER ; { Bytes to be read in. }
VAR
Buf : Contents) { Where to store the file. }
: LONG_INTEGER ;
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
GEMDOS ($3F) ;
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Gemdos File Write Command. 11111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION Fast_Write (HANDLE : INTEGER ; {File Handle. }
Count : LONG_INTEGER ; { Bytes to be read in. }
VAR
Buf : Contents) { Where to store the file. }
: LONG_INTEGER ;
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
GEMDOS ($40) ;
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Loads the buffer after reset and readln. 111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE F_Read_File (VAR
Txt_Buffer : Buffer) ;
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
BEGIN ;
Txt_Buffer.Buffer_Len := F_Read (Txt_Buffer.File_Handle,
Contents_Size, Txt_Buffer.Buffer_Contents) ;
Txt_Buffer.Buffer_Contents[ Contents_Size + 1 ] := CHR (1) ;
IF Txt_Buffer.Buffer_Len >= 0
THEN
BEGIN ; { No error occured.}
Txt_Buffer.Eof_Buffer := FALSE ;
Txt_Buffer.Buffer_Pos := 1 ;
Txt_Buffer.No_Error := TRUE ;
IF Txt_Buffer.Buffer_Len = Contents_Size
THEN Txt_Buffer.Last_Buffer := FALSE
ELSE
BEGIN ; { Less than full buffer was loaded. }
Txt_Buffer.Last_Buffer := TRUE ;
IF Txt_Buffer.Buffer_Len = 0
THEN Txt_Buffer.Eof_Buffer := TRUE ;
END ;
{was Txt_Buffer.Pos_In_File := Txt_Buffer.End_Pos + 1 ;}
{changed to try and fix read past sof error}
Txt_Buffer.Pos_In_File := Txt_Buffer.End_Pos ;
Txt_Buffer.End_Pos := Txt_Buffer.End_Pos + Txt_Buffer.Buffer_Len ;
END{ Of No error occured.}
ELSE
BEGIN ; {error occured.}
Txt_Buffer.Buffer_Pos := 1 ;
Txt_Buffer.Error_Number := INT (Txt_Buffer.Buffer_Len) ;
Txt_Buffer.No_Error := FALSE ;
Txt_Buffer.Buffer_Len := 0 ;
Txt_Buffer.Last_Buffer := TRUE ;
Txt_Buffer.Eof_Buffer := TRUE ;
END ; {of error occured. }
END ; {of procedure f_read_file. }
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Gemdos File Seek Command. 11111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION C_Seek ( POS : LONG_INTEGER ;
HANDLE, Mode : INTEGER)
: LONG_INTEGER ; { Error Number. }
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
{ For this application, mode is always set to 0 for writing}
{ the file only. }
GEMDOS ($42) ;
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Resets the file position quickly, and/or reads in 11111}
{1111 another buffer full. 11111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION F_Rseek (VAR
A_Buffer : Buffer ;
POS : LONG_INTEGER) : BOOLEAN ;
VAR
Good : LONG_INTEGER ;
BEGIN ;
IF (A_Buffer.Pos_In_File >= POS)
AND (A_Buffer.End_Pos <= POS)
THEN
BEGIN ;
F_Rseek := TRUE ;
A_Buffer.Buffer_Pos := POS - A_Buffer.Pos_In_File ;
END
ELSE
BEGIN ; {we have to really get it from the disk.}
Good := C_Seek ( POS, A_Buffer.File_Handle, 0) ;
IF Good < 0
THEN
BEGIN ; {It's an error! }
Good := C_Seek ( A_Buffer.End_Pos + 1, A_Buffer.File_Handle, 0) ;
A_Buffer.Pos_In_File := POS ;
A_Buffer.End_Pos := POS + A_Buffer.Buffer_Len ;
F_Rseek := FALSE ;
END
ELSE
BEGIN ; {It's a valid seek.}
F_Read_File (A_Buffer) ;
A_Buffer.Pos_In_File := POS ;
A_Buffer.End_Pos := POS + A_Buffer.Buffer_Len ;
F_Rseek := TRUE ;
END ;
END ;
END ; {of function f_rseek.}
{1111111111111111111111111111111111111111111111111111111111111}
{1111 writes and sets up the file here. 1111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE F_Write_File (VAR
A_Buffer : Buffer) ;
VAR
Bytes_Written : LONG_INTEGER ;
BEGIN ;
WITH A_Buffer DO
BEGIN ;
Bytes_Written := Fast_Write (File_Handle, Buffer_Len, Buffer_Contents) ;
IF (Bytes_Written < 0) or (Bytes_Written <> Buffer_Len )
THEN
BEGIN ; {Error occured. }
No_Error := FALSE ;
Error_Number := (-10 ) ;
Buffer_Pos := 1 ;
Buffer_Len := 0 ;
END{Of error occurred. }
ELSE
BEGIN ; {No error. }
No_Error := TRUE ;
Error_Number := 0 ;
Buffer_Pos := 1 ;
Buffer_Len := 0 ;
END ; {Of no error. }
END ; {Of with A_Buffer do Begin. }
END ; {Of procedure F_Write_File. }
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Close the file here. 11111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE F_Close (VAR
Txt_Buffer : Buffer) ;
{ This routine is allowed to be called by the programmer. }
BEGIN ;
WITH Txt_Buffer DO
BEGIN ;
IF Reading_File
THEN
BEGIN ;
Buffer_Pos := 1 ;
Buffer_Len := 0 ;
Last_Buffer := TRUE ;
Eof_Buffer := TRUE ;
Error_Number := File_Close (File_Handle) ;
IF (Error_Number < 0)
THEN No_Error := FALSE
ELSE No_Error := TRUE ;
END
ELSE
BEGIN ; {We're writing to this file. }
Buffer_Pos := Fast_Write (File_Handle, Buffer_Len, Buffer_Contents) ;
IF Buffer_Pos <> Buffer_Len
THEN
BEGIN ; {Errror occured}
Error_Number := File_Close (File_Handle) ;
Error_Number := INT (Buffer_Pos) ;
No_Error := FALSE ;
END
ELSE
BEGIN ;
Last_Buffer := TRUE ;
Eof_Buffer := TRUE ;
Error_Number := File_Close (File_Handle) ;
IF (Error_Number < 0)
THEN No_Error := FALSE
ELSE No_Error := TRUE ;
END ;
END ;
END ; {of with txt_Buffer do. }
END ; {of procedure F_Close);}
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Checks for the End Of File. 11111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION F_Eof (VAR
Txt_Buffer : Buffer)
: BOOLEAN ;
{Returns True if EOF has been reached/else returns false. }
{ This routine is allowed to be called by the programmer }
BEGIN ;
IF Txt_Buffer.Eof_Buffer
THEN F_Eof := TRUE
ELSE F_Eof := FALSE ;
END ; {Of function F_EOF.}
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Checks for the Start Of File. 111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION F_Sof (VAR
Txt_Buffer : Buffer)
: BOOLEAN ;
{Returns True if EOF has been reached/else returns false. }
{ This routine is allowed to be called by the programmer }
BEGIN ;
IF Txt_Buffer.Sof_Buffer
THEN F_Sof := TRUE
ELSE F_Sof := FALSE ;
END ; {Of function F_SOF.}
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Checks to see if an error has occured. 11111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION F_Error (VAR
Txt_Buffer : Buffer)
: BOOLEAN ;
{ This routine is allowed to be called by the programmer. }
{ Returns True if error occured, else returns false. }
BEGIN ;
IF Txt_Buffer.No_Error
THEN F_Error := FALSE
ELSE F_Error := TRUE ;
END ; {Of function F_Error.}
{1111111111111111111111111111111111111111111111111111111111111}
{1111 Returns the error number if an error has occurred. 111}
{1111111111111111111111111111111111111111111111111111111111111}
FUNCTION F_Io_Result (VAR
Txt_Buffer : Buffer)
: INTEGER ; { Error number returned here. }
{ This routine is allowed to be called by the programmer. }
BEGIN ;
IF NOT Txt_Buffer.No_Error
THEN F_Io_Result := Txt_Buffer.Error_Number
ELSE F_Io_Result := 0 ;
END ; {Of function F_error_number.}
{1111111111111111111111111111111111111111111111111111111111111}
{11111 Converts A_File_Name to Fast Read format. 11111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE Make_Path (VAR
A_File_Name : STRING ;
VAR
F_File_Name : Path_Chars) ;
VAR
X, Len : INTEGER ;
BEGIN ;
Len := LENGTH (A_File_Name) ;
FOR X := 1 TO Len DO
F_File_Name[ X ] := A_File_Name[ X ] ;
F_File_Name[ Len + 1 ] := CHR (0) ;
END ;
{1111111111111111111111111111111111111111111111111111111111111}
{11111 Resets the file for reading. 111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE F_Reset (VAR
Txt_Buffer : Buffer ;
A_File_Name : STRING ) ; {file name to be opened. }
{ This routine is allowed to be called by the programmer. }
VAR
{ Used to convert file_name to C format. }
F_File_Name : Path_Chars ;
BEGIN ;
{ Convert to "C" format. }
Make_Path (A_File_Name, F_File_Name) ;
{Set constants.}
Txt_Buffer.Fast_Return := CHR (13) ;
Txt_Buffer.Fast_Line_Feed := CHR (10) ;
{ Open it.}
Txt_Buffer.File_Handle := F_Open (F_File_Name, 0) ; {file name, mode of}
{read.}
IF Txt_Buffer.File_Handle >= 0
THEN
BEGIN ;
F_Read_File (Txt_Buffer) ; {load the buffer.}
Txt_Buffer.Pos_In_File := Txt_Buffer.Buffer_Pos-1 ;
Txt_Buffer.End_Pos := Txt_Buffer.Buffer_Len ;
Txt_Buffer.Reading_File := TRUE ;
Txt_Buffer.Sof_buffer := TRUE ;
END
ELSE
BEGIN ; {error occured in opening it.}
WITH Txt_Buffer DO
BEGIN ;
Buffer_Pos := 1 ;
Buffer_Len := 0 ;
Last_Buffer := TRUE ;
Eof_Buffer := TRUE ;
Sof_Buffer := TRUE ;
Error_Number := HANDLE ;
No_Error := FALSE
END ; {of with txt_Buffer do. }
END ; {of error occured in opening it. }
END ; {of procedure F_Reset. }
{1111111111111111111111111111111111111111111111111111111111111}
{11111 Sets up the file for writing. 11111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE F_Rewrite (VAR
Txt_Buffer : Buffer ;
A_File_Name : STRING ) ; {file name to be opened. }
{ This routine is allowed to be called by the programmer. }
VAR
{ Used to convert file_name to C format. }
F_File_Name : Path_Chars ;
BEGIN ;
{ Convert to "C" format. }
Make_Path (A_File_Name, F_File_Name) ;
{Set constants.}
Txt_Buffer.Fast_Return := CHR (13) ;
Txt_Buffer.Fast_Line_Feed := CHR (10) ;
{ Open it.}
Txt_Buffer.File_Handle := F_Create (F_File_Name, 0) ; {file name, mode of}
{ if txt_buffer.file_Handle>=0}
{ then Txt_Buffer.File_Handle := F_Open (F_File_Name, 1) ;}{file name, mode of}
{read.}
IF Txt_Buffer.File_Handle >= 0
THEN
BEGIN ;
WITH Txt_Buffer DO
BEGIN ;
Buffer_Pos := 1 ;
Buffer_Len := 0 ;
Last_Buffer := FALSE ;
Eof_Buffer := FALSE ;
Error_Number := 0 ;
No_Error := TRUE ;
Reading_File := FALSE ;
END ; {of with txt_Buffer do. }
END
ELSE
BEGIN ; {error occured in opening it.}
WITH Txt_Buffer DO
BEGIN ;
Buffer_Pos := 1 ;
Buffer_Len := 0 ;
Last_Buffer := TRUE ;
Eof_Buffer := TRUE ;
Error_Number := HANDLE ;
No_Error := FALSE
END ; {of with txt_Buffer do. }
END ; {of error occured in opening it. }
END ; {of procedure F_Rewrite. }
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE F_Readln (VAR
A_Buffer : Buffer ;
VAR
Txt_Line : Max_String) ; {Text line returned. }
{ This routine is allowed to be called by the programmer. }
VAR
Counter : INTEGER ; {the length of the line returned. }
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
PROCEDURE F_Read_It ;
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
BEGIN ;
WITH A_Buffer DO
BEGIN ;
IF (NOT Eof_Buffer)
THEN
BEGIN ; { Load the string. }
WHILE (Buffer_Contents[ INT (Buffer_Pos) ] <> Fast_Return)
AND (Counter < String_Size)
AND (Buffer_Pos <= Buffer_Len ) DO
BEGIN ;
Counter := Counter + 1 ;
Txt_Line[ Counter ] := Buffer_Contents[ INT (Buffer_Pos) ] ;
Buffer_Pos := Buffer_Pos + 1 ;
END ;
IF (Buffer_Pos <= Buffer_Len)
AND (Buffer_Contents[ INT (Buffer_Pos) ] = Fast_Return )
THEN
BEGIN ; { Normal end of line hit. }
Txt_Line[ 0 ] := CHR (Counter) ;
Buffer_Pos := Buffer_Pos + 2 ;
IF (Buffer_Pos > Buffer_Len)
AND (NOT Last_Buffer)
THEN
BEGIN ; {Load the buffer again. }
F_Read_File (A_Buffer) ;
IF Buffer_Contents [ 1 ] = Fast_Line_Feed
THEN Buffer_Pos := 2
ELSE Buffer_Pos := 1 ;
END ; {of load the buffer again.}
END{of buffer_pos = chr(12). }
{ Is the string full? }
ELSE IF (Counter >= String_Size)
THEN Txt_Line[ 0 ] := CHR (Counter)
ELSE IF (Buffer_Pos > Buffer_Len)
AND (NOT Last_Buffer)
THEN
BEGIN ; {Have to load and read again. }
{ Load it here. }
F_Read_File (A_Buffer) ; {load the buffer.}
{ Finish reading the line here.}
IF No_Error
THEN F_Read_It
ELSE Txt_Line[ 0 ] := CHR (Counter) ;
END{ of have to load it again.}
{ Did we hit the last char in the file? }
ELSE IF (Buffer_Pos > Buffer_Len)
AND ( Last_Buffer)
THEN
BEGIN ; {set length to counter and eof to true. }
Txt_Line[ 0 ] := CHR (Counter) ;
Eof_Buffer := TRUE ;
END ;
IF (Buffer_Pos > Buffer_Len)
AND ( Last_Buffer)
THEN
BEGIN ; {set length to counter and eof to true. }
Eof_Buffer := TRUE ;
END ;
END ; {of not eof buffer.}
END ; {of with buffer do begin. }
END ; {of f_Read_it. }
{------------------------------------------------------------------}
BEGIN ;
Txt_Line[ 0 ] := CHR (0) ;
Counter := 0 ;
F_Read_It ;
A_Buffer.Sof_Buffer := FALSE ;
END ; {of f_readln. }
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE F_Breadln (VAR
A_Buffer : Buffer ;
VAR
Txt_Line : Max_String) ; {Text line returned. }
{ This routine is allowed to be called by the programmer. }
{ This routine reads the file backwards from whereever you just}
{ read from. Please check for a while not SOF(Buffer) while using it.}
VAR
First : INTEGER ; {Have we seen the first "Fast Return yet?}
Temp : BOOLEAN ; {To hold value of a_buffer.sof for readln}
debug:boolean;
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
PROCEDURE F_Bread_It ;
VAR
X : BOOLEAN ;
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
BEGIN ;
if false then begin;
writeln('Entering F_Bread_It***********************************');
writeln('bufpos',a_buffer.buffer_pos,
' buf ln ',a_buffer.buffer_len,
' pos in file ',a_buffer.pos_in_file,
' eof ',a_buffer.eof_buffer,
' sof ',a_buffer.sof_buffer);
writeln('///////////////////////////////////////////////////');
end;
WITH A_Buffer DO
BEGIN ;
IF (NOT Sof_Buffer)
THEN
BEGIN ; {Go backwards}
Buffer_Pos := Buffer_Pos - 3 ;
IF Buffer_Pos < 1
THEN IF Pos_In_File > 0
THEN
BEGIN ; {call seek}
Buffer_Pos := Buffer_Pos + 3 ;
X := F_Rseek ( A_Buffer, Buffer_Pos - Contents_Size) ;
Buffer_Pos := Buffer_Len ;
{ Pos_In_File := Pos_In_File - 1 ;}
F_Bread_It ;
END
ELSE Sof_Buffer := TRUE ;
WHILE (Buffer_Pos >= 1 )
AND (First <> 2) DO
BEGIN ;
IF (Buffer_Contents[ INT (Buffer_Pos) ] = Fast_Return)
THEN First := First + 1 ;
Buffer_Pos := Buffer_Pos - 1 ;
END ;
IF (Buffer_Pos > 1 )
AND (First = 2)
THEN
BEGIN ;
Buffer_Pos := Buffer_Pos + 3 ;
END
{Did we hit the start of the file? }
ELSE IF (Buffer_Pos < 1 )
AND (Pos_In_File = 0)
THEN
BEGIN ; {set Sof to true. }
Sof_Buffer := TRUE ;
buffer_pos:=1;
END
ELSE
BEGIN ; {call seek}
X := F_Rseek ( A_Buffer, Pos_In_File - Contents_Size) ;
Buffer_Pos := Buffer_Len ;
F_Bread_It ;
END ;
END ;
END ; {of with buffer do begin. }
END ; {of f_Read_it. }
{------------------------------------------------------------------}
BEGIN ;
First := 0 ;
F_Bread_It ;
Temp := A_Buffer.Sof_Buffer ;
F_Readln (A_Buffer, Txt_Line) ;
A_Buffer.Sof_Buffer := Temp ;
END ; {of f_breadln. }
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE F_Writeln (VAR
A_Buffer : Buffer ;
VAR
Txt_Line : Max_String) ; {Text line returned. }
{ This routine is allowed to be called by the programmer. }
VAR
String_Size, { The size of the string. }
Counter : INTEGER ; {the length of the line returned. }
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
PROCEDURE F_Write_It ;
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
BEGIN ;
WITH A_Buffer DO
BEGIN ;
WHILE (Counter < String_Size)
AND (Buffer_Pos <= Contents_Size ) DO
BEGIN ;
Counter := Counter + 1 ;
Buffer_Contents[ INT (Buffer_Pos) ] := Txt_Line[ Counter ] ;
Buffer_Pos := Buffer_Pos + 1 ;
END ;
Buffer_Len := Buffer_Pos - 1 ;
IF (Buffer_Pos <= Contents_Size - 1)
THEN
BEGIN ; { Normal end of line hit. }
Buffer_Contents[ INT (Buffer_Pos) ] := Fast_Return ;
Buffer_Pos := Buffer_Pos + 1 ;
Buffer_Contents[ INT (Buffer_Pos) ] := Fast_Line_Feed ;
Buffer_Pos := Buffer_Pos + 1 ;
Buffer_Len := Buffer_Len + 2 ;
IF (Buffer_Len = Contents_Size)
THEN F_Write_File (A_Buffer) ;
END{of buffer_pos <= Contents_Size. }
ELSE IF (Buffer_Pos > Contents_Size)
THEN
BEGIN ; {Have to write it and finsh the line. }
{ Write it here. }
F_Write_File (A_Buffer) ; {load the buffer.}
{ Finish writing the line here.}
IF No_Error
THEN F_Write_It ;
END
ELSE
BEGIN ;
{The end of the line occurs at the buffer boudary.}
IF Buffer_Pos = Contents_Size
THEN
BEGIN ;
Buffer_Contents[ INT (Buffer_Pos) ] := Fast_Return ;
Buffer_Len := Buffer_Len + 1 ;
F_Write_File (A_Buffer) ;
Buffer_Contents[ INT (Buffer_Pos) ] := Fast_Line_Feed ;
Buffer_Pos := Buffer_Pos + 1 ;
Buffer_Len := Buffer_Len + 1 ;
END
ELSE
BEGIN ; {Buffer_Pos > Contents_Size. }
F_Write_File (A_Buffer) ;
Buffer_Contents[ INT (Buffer_Pos) ] := Fast_Return ;
Buffer_Pos := Buffer_Pos + 1 ;
Buffer_Contents[ INT (Buffer_Pos) ] := Fast_Line_Feed ;
Buffer_Pos := Buffer_Pos + 1 ;
Buffer_Len := Buffer_Len + 2 ;
END ;
END ; {The end of the line occurs at the buffer boudary.}
END ; {of with A_Buffer do begin. }
END ; {of F_Write_It. }
{------------------------------------------------------------------}
BEGIN ;
String_Size := LENGTH (Txt_Line) ;
Counter := 0 ;
F_Write_It ;
END ; {of F_Writeln. }
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111}
PROCEDURE F_Write (VAR
A_Buffer : Buffer ;
VAR
Txt_Line : Max_String) ; {Text line returned. }
{ This routine is allowed to be called by the programmer. }
VAR
String_Size, { The size of the string. }
Counter : INTEGER ; {the length of the line returned. }
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
{2222222222222222222222222222222222222222222222222222222222222}
PROCEDURE F_Write_2it ;
{ This routine is NOT TO BE CALLED BY THE PROGRAMMER!!! }
BEGIN ;
WITH A_Buffer DO
BEGIN ;
WHILE (Counter < String_Size)
AND (Buffer_Pos <= Contents_Size ) DO
BEGIN ;
Counter := Counter + 1 ;
Buffer_Contents[ INT (Buffer_Pos) ] := Txt_Line[ Counter ] ;
Buffer_Pos := Buffer_Pos + 1 ;
END ;
Buffer_Len := Buffer_Pos - 1 ;
IF (Buffer_Pos <= Contents_Size )
THEN
BEGIN ; { Normal end of line hit. }
{ Don't do anything.}
END
ELSE IF (Buffer_Pos > Contents_Size)
THEN
BEGIN ; {Have to write it and finsh the line. }
{ Write it here. }
F_Write_File (A_Buffer) ; {load the buffer.}
{ Finish writing the line here.}
IF No_Error
THEN F_Write_2it ;
END ;
END ; {of with A_Buffer do begin. }
END ; {of F_Write_It. }
{------------------------------------------------------------------}
BEGIN ;
String_Size := LENGTH (Txt_Line) ;
Counter := 0 ;
F_Write_2it ;
END ; {of F_Write. }
